home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / language / ici / ici.cpi / compile.c < prev    next >
C/C++ Source or Header  |  1994-10-27  |  9KB  |  421 lines
  1. #include "parse.h"
  2. #include "array.h"
  3. #include "op.h"
  4. #include "str.h"
  5.  
  6. STATIC object_t *
  7. new_binop(op)
  8. int    op;
  9. {
  10.     register object_t    *o;
  11.  
  12. #ifndef    BINOPFUNC
  13.     /*
  14.      * This is the normal code.
  15.      */
  16.     o = objof(new_op(NULL, OP_BINOP, t_subtype(op)));
  17. #else
  18.     o = objof(new_op(ici_op_binop, 0, t_subtype(op)));
  19. #endif
  20.     if (o != NULL)
  21.     loose(o);
  22.     return o;
  23. }
  24.  
  25. /*
  26.  * Compile the expression into the code array, for the reason given.
  27.  * Returns -1 on failure, 1 on success.
  28.  */
  29. int
  30. compile_expr(a, e, why)
  31. array_t    *a;
  32. expr_t    *e;
  33. int    why;
  34. {
  35.  
  36. #define    NOTLV(why)    ((why) == FOR_LVALUE ? FOR_VALUE : (why))
  37.  
  38.     if (pushcheck(a, 1))
  39.     return -1;
  40.     if (t_type(e->e_what) == T_BINOP && e->e_arg[1] != NULL)
  41.     {
  42.     if (e->e_what == T_COMMA)
  43.     {
  44.         if (compile_expr(a, e->e_arg[0], FOR_EFFECT) < 0)
  45.         return -1;
  46.         if (compile_expr(a, e->e_arg[1], why) < 0)
  47.         return -1;
  48.         return 1;
  49.     }
  50.     if (e->e_what == T_QUESTION)
  51.     {
  52.         array_t    *a1;
  53.         array_t    *a2;
  54.  
  55.         if (e->e_arg[1]->e_what != T_COLON)
  56.         {
  57.         error = "syntax error in \"? :\" use";
  58.         return -1;
  59.         }
  60.         if (compile_expr(a, e->e_arg[0], FOR_VALUE) < 0)
  61.         return -1;
  62.         if ((a1 = new_array()) == NULL)
  63.         return -1;
  64.         if (compile_expr(a1, e->e_arg[1]->e_arg[0], why) < 0)
  65.         return -1;
  66.         if ((a2 = new_array()) == NULL)
  67.         {
  68.         loose(a1);
  69.         return -1;
  70.         }
  71.         if
  72.         (
  73.         compile_expr(a2, e->e_arg[1]->e_arg[1], why) < 0
  74.         ||
  75.         pushcheck(a, 3)
  76.         )
  77.         {
  78.         loose(a1);
  79.         loose(a2);
  80.         return -1;
  81.         }
  82.         *a->a_top++ = objof(a1 = (array_t *)atom(objof(a1), 1));
  83.         *a->a_top++ = objof(a2 = (array_t *)atom(objof(a2), 1));
  84.         *a->a_top++ = objof(&o_ifelse);
  85.         loose(a1);
  86.         loose(a2);
  87.         return 1;
  88.     }
  89.     if (e->e_what == T_LESSEQGRT)
  90.     {
  91.         if (compile_expr(a, e->e_arg[0], FOR_LVALUE) < 0)
  92.         return -1;
  93.         if (compile_expr(a, e->e_arg[1], FOR_LVALUE) < 0)
  94.         return -1;
  95.         if (pushcheck(a, 1))
  96.         return -1;
  97.         if ((*a->a_top = objof(new_op(NULL, OP_SWAP, why))) == NULL)
  98.         return -1;
  99.         loose(*a->a_top);
  100.         a->a_top++;
  101.         return 1;
  102.     }
  103.     if (e->e_what == T_EQ)
  104.     {
  105.         /*
  106.          * Simple assignment.
  107.          */
  108.         if (compile_expr(a, e->e_arg[0], FOR_LVALUE) < 0)
  109.         return -1;
  110.         if (compile_expr(a, e->e_arg[1], FOR_VALUE) < 0)
  111.         return -1;
  112.         if (pushcheck(a, 1))
  113.         return -1;
  114.         if ((*a->a_top = objof(new_op(NULL, OP_ASSIGN, why))) == NULL)
  115.         return -1;
  116.         loose(*a->a_top);
  117.         a->a_top++;
  118.         return 1;
  119.     }
  120.     if (e->e_what >= T_EQ)
  121.     {
  122.         /*
  123.          * Assignment op.
  124.          */
  125.         if (compile_expr(a, e->e_arg[0], FOR_LVALUE) < 0)
  126.         return -1;
  127.         if (pushcheck(a, 1))
  128.         return 1;
  129.         *a->a_top++ = objof(&o_dotkeep);
  130.         if (compile_expr(a, e->e_arg[1], FOR_VALUE) < 0)
  131.         return -1;
  132.         if (pushcheck(a, 2))
  133.         return 1;
  134.         if ((*a->a_top = new_binop(e->e_what)) == NULL)
  135.         return -1;
  136.         ++a->a_top;
  137.         if ((*a->a_top = objof(new_op(NULL, OP_ASSIGN, why))) == NULL)
  138.         return -1;
  139.         loose(*a->a_top);
  140.         a->a_top++;
  141.         return 1;
  142.     }
  143.     if (why == FOR_LVALUE)
  144.         goto notlvalue;
  145.     if (e->e_what == T_ANDAND || e->e_what == T_BARBAR)
  146.     {
  147.         register array_t    *a1;
  148.  
  149.         if (compile_expr(a, e->e_arg[0], FOR_VALUE) < 0)
  150.         return -1;
  151.         if ((a1 = new_array()) == NULL)
  152.         return -1;
  153.         if
  154.         (
  155.         compile_expr(a1, e->e_arg[1], FOR_VALUE) < 0
  156.         ||
  157.         pushcheck(a, 3)
  158.         )
  159.         {
  160.         loose(a1);
  161.         return -1;
  162.         }
  163.         *a->a_top++ = objof(a1 = (array_t *)atom(objof(a1), 1));
  164.         loose(a1);
  165.         *a->a_top++ = objof(e->e_what == T_ANDAND ? &o_andand : &o_barbar);
  166.         if (why == FOR_EFFECT)
  167.         *a->a_top++ = objof(&o_pop);
  168.         return 1;
  169.     }
  170.     /*
  171.      * Ordinary binary op.
  172.      */
  173.     if (compile_expr(a, e->e_arg[0], why) < 0)
  174.         return -1;
  175.     if (compile_expr(a, e->e_arg[1], why) < 0)
  176.         return -1;
  177.     if (pushcheck(a, 1))
  178.         return -1;
  179.     if (why == FOR_EFFECT)
  180.         return 1;
  181.     if ((*a->a_top = new_binop(e->e_what)) == NULL)
  182.         return -1;
  183.     ++a->a_top;
  184.     return 1;
  185.     }
  186.     else
  187.     {
  188.     /*
  189.      * Not a "binary opertor".
  190.      */
  191.     if (pushcheck(a, 3)) /* Worst case below. */
  192.         return -1;
  193.     switch (e->e_what)
  194.     {
  195.     case T_NULL:
  196.         if (why != FOR_EFFECT)
  197.         *a->a_top++ = objof(&o_null);
  198.         break;
  199.  
  200.     case T_DOLLAR:
  201.         {
  202.         array_t    *a1;
  203.  
  204.         if ((a1 = new_array()) == NULL)
  205.             return -1;
  206.         if
  207.         (
  208.             compile_expr(a1, e->e_arg[0], NOTLV(why)) < 0
  209.             ||
  210.             (e->e_obj = ici_evaluate(objof(a1), NULL)) == NULL
  211.         )
  212.         {
  213.             loose(a1);
  214.             return -1;
  215.         }
  216.         loose(a1);
  217.         }
  218.         /* Fall through. */
  219.     case T_INT:
  220.     case T_FLOAT:
  221.     case T_CONST:
  222.     case T_STRING:
  223.         if (why != FOR_EFFECT)
  224.         {
  225.         if (isstring(e->e_obj))
  226.             *a->a_top++ = objof(&o_quote);
  227.         *a->a_top++ = e->e_obj;
  228.         }
  229.         break;
  230.  
  231.     case T_NAME:
  232.         if (why == FOR_LVALUE)
  233.         *a->a_top++ = objof(&o_namelvalue);
  234.         if (why != FOR_EFFECT)
  235.         *a->a_top++ = e->e_obj;
  236.         return 1;
  237.  
  238.     case T_PLUS:
  239.         if (compile_expr(a, e->e_arg[0], NOTLV(why)) < 0)
  240.         return -1;
  241.         break;
  242.  
  243.     case T_PLUSPLUS:
  244.     case T_MINUSMINUS:
  245.         if (e->e_arg[0] == NULL)
  246.         {
  247.         /*
  248.          * Postfix.
  249.          */
  250.         if (compile_expr(a, e->e_arg[1], FOR_LVALUE) < 0)
  251.             return -1;
  252.         if (why == FOR_EFFECT)
  253.             goto pluspluseffect;
  254.  
  255.         if (pushcheck(a, 4))
  256.             return -1;
  257.         *a->a_top++ = objof(&o_dotrkeep);
  258.         *a->a_top++ = objof(o_one);
  259.         if ((*a->a_top = new_binop(e->e_what == T_PLUSPLUS ? T_PLUS : T_MINUS)) == NULL)
  260.             return -1;
  261.         ++a->a_top;
  262.         if ((*a->a_top = objof(new_op(NULL, OP_ASSIGN, FOR_EFFECT))) == NULL)
  263.             return -1;
  264.         loose(*a->a_top);
  265.         a->a_top++;
  266.         }
  267.         else
  268.         {
  269.         /*
  270.          * Prefix, (or possibly postfix for effect).
  271.          */
  272.         if (compile_expr(a, e->e_arg[0], FOR_LVALUE) < 0)
  273.             return -1;
  274.         pluspluseffect:
  275.         if (pushcheck(a, 4))
  276.             return -1;
  277.         *a->a_top++ = objof(&o_dotkeep);
  278.         *a->a_top++ = objof(o_one);
  279.         if ((*a->a_top = new_binop(e->e_what == T_PLUSPLUS ? T_PLUS : T_MINUS)) == NULL)
  280.             return -1;
  281.         ++a->a_top;
  282.         if ((*a->a_top = objof(new_op(NULL, OP_ASSIGN, why))) == NULL)
  283.             return -1;
  284.         loose(*a->a_top);
  285.         a->a_top++;
  286.         return 1;
  287.         }
  288.         break;
  289.  
  290.     case T_EXCLAM:
  291.     case T_TILDE:
  292.     case T_MINUS:
  293.         if (compile_expr(a, e->e_arg[0], NOTLV(why)) < 0)
  294.         return -1;
  295.         if (why == FOR_EFFECT)
  296.         break;
  297.         if (pushcheck(a, 1))
  298.         return -1;
  299.         if ((*a->a_top = objof(new_op(op_unary, 0, t_subtype(e->e_what)))) == NULL)
  300.         return -1;
  301.         loose(*a->a_top);
  302.         ++a->a_top;
  303.         break;
  304.  
  305.     case T_AT:
  306.         if (compile_expr(a, e->e_arg[0], NOTLV(why)) < 0)
  307.         return -1;
  308.         if (why == FOR_EFFECT)
  309.         break;
  310.         if (pushcheck(a, 1))
  311.         return -1;
  312.         if ((*a->a_top = objof(new_op(NULL, OP_AT, 0))) == NULL)
  313.         return -1;
  314.         loose(*a->a_top);
  315.         ++a->a_top;
  316.         break;
  317.  
  318.     case T_AND: /* Unary. */
  319.         if (compile_expr(a, e->e_arg[0], why == FOR_VALUE ? FOR_LVALUE : why) < 0)
  320.         return -1;
  321.         if (why == FOR_EFFECT)
  322.         break;
  323.         if (pushcheck(a, 1))
  324.         return -1;
  325.         *a->a_top++ = objof(&o_mkptr);
  326.         break;
  327.  
  328.     case T_ASTERIX: /* Unary. */
  329.         if (compile_expr(a, e->e_arg[0], NOTLV(why)) < 0)
  330.         return -1;
  331.         if (why == FOR_EFFECT)
  332.         break;
  333.         if (pushcheck(a, 1))
  334.         return -1;
  335.         if (why == FOR_LVALUE)
  336.         {
  337.         *a->a_top++ = objof(&o_openptr);
  338.         return 1;
  339.         }
  340.         else
  341.         *a->a_top++ = objof(&o_fetch);
  342.         break;
  343.  
  344.     case T_ONSQUARE: /* Array or pointer index. */
  345.         if (compile_expr(a, e->e_arg[0], NOTLV(why)) < 0)
  346.         return -1;
  347.         if (compile_expr(a, e->e_arg[1], NOTLV(why)) < 0)
  348.         return -1;
  349.         if (why == FOR_EFFECT)
  350.         break;
  351.         if (pushcheck(a, 1))
  352.         return -1;
  353.         if (why == FOR_LVALUE)
  354.         return 1;
  355.         *a->a_top++ = objof(&o_dot);
  356.         break;
  357.  
  358.     case T_PTR:
  359.         if (compile_expr(a, e->e_arg[0], NOTLV(why)) < 0)
  360.         return -1;
  361.         if (why != FOR_EFFECT)
  362.         {
  363.         if (pushcheck(a, 1))
  364.             return -1;
  365.         *a->a_top++ = objof(&o_fetch);
  366.         }
  367.         goto dot2;
  368.     case T_DOT:
  369.         if (compile_expr(a, e->e_arg[0], NOTLV(why)) < 0)
  370.         return -1;
  371.     dot2:
  372.         if (compile_expr(a, e->e_arg[1], NOTLV(why)) < 0)
  373.         return -1;
  374.         if (why == FOR_EFFECT)
  375.         break;
  376.         if (why == FOR_LVALUE)
  377.         return 1;
  378.         if (pushcheck(a, 1))
  379.         return -1;
  380.         *a->a_top++ = objof(&o_dot);
  381.         break;
  382.     
  383.     case T_ONROUND: /* Function call. */
  384.         {
  385.         int    nargs;
  386.         expr_t    *e1;
  387.  
  388.         nargs = 0;
  389.         for (e1 = e->e_arg[1]; e1 != NULL; e1 = e1->e_arg[1])
  390.         {
  391.             if (compile_expr(a, e1->e_arg[0], FOR_VALUE) < 0)
  392.             return -1;
  393.             ++nargs;
  394.         }
  395.         if (compile_expr(a, e->e_arg[0], FOR_VALUE) < 0)
  396.             return -1;
  397.         if (pushcheck(a, 2))
  398.             return -1;
  399.         if ((*a->a_top = objof(new_op(NULL, OP_CALL, nargs))) == NULL)
  400.             return -1;
  401.         loose(*a->a_top);
  402.         ++a->a_top;
  403.         if (why == FOR_EFFECT)
  404.             *a->a_top++ = objof(&o_pop);
  405.         }
  406.         break;
  407.     }
  408.     }
  409.     if (why == FOR_LVALUE)
  410.     {
  411.     if (pushcheck(a, 1))
  412.         return -1;
  413.     *a->a_top++ = objof(&o_mklvalue);
  414.     }
  415.     return 1;
  416.  
  417. notlvalue:
  418.     error = "lvalue required";
  419.     return -1;
  420. }
  421.